home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / BUSINESS / SALE24.ARJ / REPORTER.SC < prev    next >
Text File  |  1992-05-02  |  12KB  |  476 lines
  1. ;******************************************
  2. ; REPORTER.SC
  3. ; Copyright (C) 1992 SHARED LOGIC, INC.
  4. ;  ALL RIGHTS RESERVED.
  5. ;  May be used if credit is given.
  6. ; Use at your own risk: the author makes
  7. ;  no warranties nor guarantees.
  8. ; Author:  Tim Colling
  9. ; Purpose: Script for the REPORTER()
  10. ;  proc described in Data Based Advisor
  11. ;  Magazine
  12. ;******************************************
  13.  
  14. lib_name = "paradox"
  15. if not isfile(lib_name+".lib") then
  16.  createlib "paradox" size 300
  17.  endif
  18.  
  19. ? "Compiling reporter() procs"
  20.  
  21. ;******************************************
  22. ;                                reporter()
  23. ;******************************************
  24. ;Purpose: To permit the user to run a
  25. ; report, specifying the print style from
  26. ; a standard "config" table with such
  27. ; information.
  28.  
  29. proc reporter(
  30.  table2use,        ;The table to report from
  31.  report2use,       ;The report to be used
  32.  destination,      ;Where to send the report
  33.  printstyle2use,   ;Style selection, or As-Is
  34.  continuous,       ;True=>Page Length = "c"
  35.  configTable,      ;System configuration file
  36.  specialReportProc,;Special report proc name
  37.  filename.to.use)  ;Name of file to create
  38.  
  39. private
  40.  setupstring,  ;The printer setup string
  41.  linesperpage, ;The number of lines per page
  42.  printerport,  ;The port to be used
  43.  family.rights,;True=>user has"R"tablerights
  44.  proc.name,    ;This proc's name
  45.  old.margin,   ;Report's orig margin setting
  46.  original.destination,;Dest in proc call
  47.  original.setup, ;Report's orig setup string
  48.  Choice        ;Menu selection
  49.  
  50. proc.name="reporter"
  51.  
  52. original.destination = upper(destination)
  53.  
  54. while true
  55.  working_message("")
  56.  
  57.  reporter.parm.checker()
  58.  if retval = false then
  59.   return false
  60.   endif
  61.  
  62.  if isassigned(printerport) then
  63.   setprinter printerport
  64.   endif
  65.  
  66.  working_message("Making final "+
  67.   "preparations for producing "+
  68.   "your output.")
  69.  
  70.  if continuous then
  71.   linesperpage = "C"
  72.   endif
  73.  
  74.  ;Open up the report spec file
  75.  menu {report} {change}
  76.  select table2use
  77.  select report2use
  78.  enter
  79.  
  80.  ;Set the PRINTERPORT
  81.  ;----------------------
  82.  menu
  83.  {setting} {setup} {custom}
  84.  select printerport
  85.  enter
  86.  
  87.  ;Set the SETUPSTRING
  88.  ;and LINESPERPAGE values
  89.  ;------------------------
  90.  if not printstyle2use = "AS-IS" then
  91.   menu {setting} {setup} {custom} enter
  92.   ctrlbackspace typein setupstring enter
  93.   menu {setting} {pagelayout} {length}
  94.   ctrlbackspace typein linesperpage
  95.   enter
  96.   endif
  97.  
  98.  ;Do any other custom work by
  99.  ;calling the special report proc
  100.  ;-------------------------------
  101.  if not isblank(specialReportProc) then
  102.   execproc specialReportProc
  103.   endif
  104.  
  105.  working_message("Producing your output."+
  106.  "  Press any key to interrupt.")
  107.  while true
  108.   switch
  109.    case destination = "PRINTER":
  110.    ;----------------------------
  111.     open printer
  112.     menu {output} {printer}
  113.     if retval=1 then    ;we must have
  114.      reset return false ;triggered the
  115.      endif              ;errorproc
  116.     working_message("")
  117.     close printer
  118.     if original.destination = "OPTION" then
  119.      destination = "OPTION"
  120.      loop
  121.      endif
  122.     DoReportAgainMenu()
  123.     if retval then
  124.      loop
  125.     else
  126.      ExitChoice = true
  127.      quitloop
  128.      endif
  129.    case destination = "SCREEN":
  130.    ;----------------------------
  131.     ;Save the original margin
  132.     ;and then set the margin
  133.     ;to zero to maximize the
  134.     ;amount of text displayed
  135.     ;on the initial screen
  136.     ;------------------------
  137.     menu {setting} {margin}
  138.     old.margin = menuchoice()
  139.     {0}
  140.     ;Save the original setup string
  141.     ;and then eliminate it so that
  142.     ;it doesn't clutter up the
  143.     ;screen display
  144.     ;------------------------------
  145.     menu {setting} {setup} {custom}
  146.     enter
  147.     old.setup = menuchoice()
  148.     ctrlbackspace
  149.     enter
  150.     ;Send the report to a file
  151.     ;-------------------------
  152.     menu {output} {file}
  153.     select privdir()+"report.t"
  154.     if menuchoice()="Cancel" then
  155.      {Replace}
  156.      endif
  157.     ;Use README.COM to display the file
  158.     ;----------------------------------
  159.     run "readme "+privdir()+"report.t"
  160.     if retval=1 then    ;we must have
  161.      reset return false ;triggered the
  162.      endif              ;errorproc
  163.     working_message("")
  164.     run norefresh "del "+privdir()+"report.t"
  165.     ;Restore original margin
  166.     ;------------------------
  167.     menu {setting} {margin}
  168.     select old.margin
  169.     ;Restore original setup string
  170.     ;-----------------------------
  171.     menu {setting} {setup}
  172.     {custom} enter
  173.     select old.setup
  174.     if original.destination = "OPTION" then
  175.      destination = "OPTION"
  176.      loop
  177.      endif
  178.     DoReportAgainMenu()
  179.     if retval then
  180.      loop
  181.     else
  182.      ExitChoice = true
  183.      quitloop
  184.      endif
  185.    case destination = "FILE":
  186.    ;----------------------------
  187.     menu {output} {file}
  188.     select privdir()+filename.to.use
  189.     if menuchoice()="Cancel" then
  190.      {Replace}
  191.      endif
  192.     if retval=1 then    ;we must have
  193.      reset return false ;triggered the
  194.      endif              ;errorproc
  195.     working_message("")
  196.     if original.destination = "OPTION" then
  197.      destination = "OPTION"
  198.      loop
  199.      endif
  200.     DoReportAgainMenu()
  201.     if retval then
  202.      loop
  203.     else
  204.      ExitChoice = true
  205.      quitloop
  206.      endif
  207.    case destination = "OPTION":
  208.    ;----------------------------
  209.     showmenu
  210.      "Printer":
  211.       "Send the report to your Printer",
  212.      "Screen":
  213.       "Send the report to your Screen",
  214.      "File":
  215.       "Send the report to a File "+
  216.       "in your private directory",
  217.      "Done":
  218.       "Done with this report job"
  219.     to destination
  220.     working_message("")
  221.     if not retval then
  222.      ;User pressed Esc,
  223.      ;therefore we are DONE
  224.      ;--------------------
  225.      destination = "DONE"
  226.      endif
  227.     destination = upper(destination)
  228.     switch
  229.      case destination = "PRINTER":
  230.       ExitChoice = false
  231.       quitloop
  232.      case destination = "FILE":
  233.       while true
  234.        @ 1,0 clear eol
  235.        @ 0,0 clear eol
  236.        cursor normal
  237.        @ 1,0 ?? "File Extension must be "+
  238.         "either TXT, RPT, DOC, PRN"
  239.        @ 0,0 ?? "Please enter the filename :"
  240.        accept "A12"
  241.         picture
  242.          "&{*7[&,#,_]}.{TXT,DOC,PRN,RPT}"
  243.         to filename.to.use
  244.        if not retval then
  245.         destination = "OPTION"
  246.         quitloop
  247.        endif
  248.        cursor off
  249.        working_message("")
  250.        if isfile(privdir()+
  251.         filename.to.use) then
  252.         showmenu
  253.          "No":
  254.           "Do NOT Overwrite existing File",
  255.          "Yes":
  256.           "Overwrite existing File"
  257.         to Choice
  258.         switch
  259.          case Choice = "No" : loop
  260.          case Choice = "Yes": quitloop
  261.         endswitch
  262.         endif
  263.        quitloop
  264.       endwhile
  265.       loop
  266.      case destination = "SCREEN":
  267.       working_message("")
  268.       loop
  269.      case destination = "DONE":
  270.       ExitChoice = true
  271.       quitloop
  272.     endswitch
  273.   endswitch
  274.  endwhile
  275.  {cancel} {yes}
  276.  if ExitChoice then
  277.   quitloop
  278.  else
  279.   loop
  280.   endif
  281. endwhile
  282. return true
  283.  
  284. endproc
  285. writelib lib_name reporter
  286. release procs reporter
  287. ?? "."
  288.  
  289. ;******************************************
  290. ;                   reporter.parm.checker()
  291. ;******************************************
  292. ;Purpose: checks the parameters used with 
  293. ; the reporter() proc
  294. proc reporter.parm.checker()
  295.  
  296. private proc.name
  297.  
  298. proc.name = "reporter.parm.checker"
  299.  
  300. if isempty( table2use ) then
  301.  error_message(
  302.  "Sorry, the table \"" + table2use +
  303.  "\" is empty. There is nothing to report.",
  304.  "Press any key to continue.",500)
  305.  return false
  306.  endif
  307.  
  308. destination = upper( destination )
  309. printstyle2use = upper( printstyle2use )
  310.  
  311. if destination <> "PRINTER" and
  312.  destination <> "SCREEN"  and
  313.  destination <> "FILE"  and
  314.  destination <> "OPTION"  then
  315.  error_message(
  316.  "Sorry, an incorrect report destination "+
  317.  "is specified in this program.",
  318.  "Press any key to continue." ,500)
  319.  return false
  320.  endif
  321.  
  322. if printstyle2use <> "10-PITCH" and
  323.  printstyle2use <> "CONDENSED" and
  324.  printstyle2use <> "AS-IS" then
  325.  error_message(
  326.  "Sorry, an incorrect print style is "+
  327.  "specified in this program.",
  328.  "Press any key to continue." ,500)
  329.  return false
  330.  endif
  331.  
  332. if type(continuous)<> "L" then
  333.  error_message(
  334.  "Sorry, an incorrect \"continuous\" "+
  335.  "argument is specified in "+
  336.  "this program.",
  337.  "Press any key to continue.",500)
  338.  return false
  339.  endif
  340.  
  341. ;The ConfigTable is essential to this
  342. ;proc and cannot be done without
  343. ;--------------------------------------
  344. if not istable( configtable ) then
  345.  error_message(
  346.  "Error: there is no \"config\" table.  "+
  347.  "The output is cancelled.",
  348.  "Please advise your system administrator."+
  349.  "  Press any key to go on.",500)
  350.  return false
  351.  endif
  352.  
  353. ;Get the setup string, pagelength and
  354. ;printer to be used
  355. ;--------------------------------------
  356. view configtable
  357. switch
  358.  case printstyle2use = "10-PITCH" :
  359.   setupstring  = [Printer setup - 10 pitch]
  360.   linesperpage = [Lines per pg - 10 pitch]
  361.   printerport  = [Printer port]
  362.  case printstyle2use = "CONDENSED" :
  363.   setupstring  = [Printer setup - condensed]
  364.   linesperpage = [Lines per pg - condensed]
  365.   printerport  = [Printer port]
  366.  case printstyle2use = "AS-IS" :
  367.   printerport  = [Printer port]
  368. endswitch
  369.  
  370. clearimage
  371.  
  372. family.rights = 
  373.  familyrights( table2use, "R" )
  374. if family.rights = false then
  375.  error_message(
  376.  "ENCRYPTION ERROR: Family Rights must "+
  377.  "include \"R\" for table " +
  378.  table2use + ".",
  379.  "Contact your System Supervisor for "+
  380.  "assistance.  Press any key to continue.",
  381.  500)
  382.  return false
  383.  endif
  384. return true
  385. endproc
  386.  
  387. writelib lib_name reporter.parm.checker
  388. release procs reporter.parm.checker
  389. ?? "."
  390.  
  391. ;******************************************
  392. ;                         working_message()
  393. ;******************************************
  394. ;Purpose: puts up working message with 
  395. ; optional second line
  396. proc working_message(txt)
  397. private proc.name
  398. proc.name = "working_message"
  399. @ 1,0 clear eol ?? txt
  400. @ 0,0 clear eol ?? "Working" 
  401. style blink ?? "..." 
  402. style cursor off
  403. endproc
  404. ?? "." writelib lib_name working_message
  405. release procs working_message
  406.  
  407. ;******************************************
  408. ;                           error_message()
  409. ;******************************************
  410. ;Purpose: presents an error message to the 
  411. ; user and waits for a keypress
  412. proc error_message( 
  413.  txt1,      ;Text to place on line 1
  414.  txt2,      ;Text to place on line 2
  415.  duration ) ;interval between beeps
  416. private proc.name
  417. proc.name = "error_message"
  418. @ 1,0 clear eol ?? txt2
  419. @ 0,0 clear eol ?? txt1
  420. cursor off
  421. beep
  422. while charwaiting()
  423.  retval = getchar()
  424. endwhile
  425. ;If duration is 0, then don't beep 
  426. ; anymore.  Otherwise, use duration
  427. ; as the sleep interval between beeps
  428. ;------------------------------------
  429. while duration <> 0 and not charwaiting()
  430.  beep
  431.  sleep duration
  432. endwhile
  433. return getchar()
  434.  
  435. endproc
  436. proc.name = "error_message"
  437. writelib lib_name error_message
  438. release procs error_message
  439.  
  440. ;******************************************
  441. ;                       DoReportAgainMenu()
  442. ;******************************************
  443. ;Purpose: Ask the user whether to 
  444. ; reprint a report that has just been 
  445. ; printed.  Returns true if user selects 
  446. ; "Do-Again", otherwise returns false.  
  447. ; Checks for charwaiting() to avoid any 
  448. ; typing ahead
  449.  
  450. proc DoReportAgainMenu()
  451.  
  452. private proc.name, choice
  453.  
  454. proc.name = "DoReportAgainMenu"
  455.  
  456. while charwaiting()
  457.  choice = getchar()
  458. endwhile
  459.  
  460. while true
  461.  showmenu
  462.   "DoAgain" : "Repeat the output process.",
  463.   "Finished": "Finished with output. Okay to return."
  464.    to choice
  465.  working_message("")
  466.  if choice = "Esc" Or choice = "Finished" then
  467.   return false
  468.  else
  469.   return true
  470.  endif
  471. endwhile
  472.  
  473. endproc
  474. writelib lib_name DoReportAgainMenu
  475. release procs DoReportAgainMenu
  476. ?? "."